home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch7 / Stretch2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-05-04  |  8.8 KB  |  244 lines
  1. VERSION 5.00
  2. Begin VB.Form frmStretch2 
  3.    Caption         =   "Stretch2"
  4.    ClientHeight    =   4965
  5.    ClientLeft      =   165
  6.    ClientTop       =   450
  7.    ClientWidth     =   4935
  8.    LinkTopic       =   "Form2"
  9.    ScaleHeight     =   4965
  10.    ScaleWidth      =   4935
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.PictureBox picOriginal 
  13.       AutoRedraw      =   -1  'True
  14.       AutoSize        =   -1  'True
  15.       Height          =   2310
  16.       Left            =   120
  17.       Picture         =   "Stretch2.frx":0000
  18.       ScaleHeight     =   150
  19.       ScaleMode       =   3  'Pixel
  20.       ScaleWidth      =   150
  21.       TabIndex        =   3
  22.       Top             =   120
  23.       Width           =   2310
  24.    End
  25.    Begin VB.PictureBox picResult 
  26.       AutoRedraw      =   -1  'True
  27.       Height          =   2310
  28.       Index           =   0
  29.       Left            =   2520
  30.       ScaleHeight     =   150
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   150
  33.       TabIndex        =   2
  34.       Top             =   120
  35.       Width           =   2310
  36.    End
  37.    Begin VB.PictureBox picResult 
  38.       AutoRedraw      =   -1  'True
  39.       Height          =   2310
  40.       Index           =   1
  41.       Left            =   120
  42.       ScaleHeight     =   150
  43.       ScaleMode       =   3  'Pixel
  44.       ScaleWidth      =   150
  45.       TabIndex        =   1
  46.       Top             =   2520
  47.       Width           =   2310
  48.    End
  49.    Begin VB.PictureBox picResult 
  50.       AutoRedraw      =   -1  'True
  51.       Height          =   2310
  52.       Index           =   2
  53.       Left            =   2520
  54.       ScaleHeight     =   150
  55.       ScaleMode       =   3  'Pixel
  56.       ScaleWidth      =   150
  57.       TabIndex        =   0
  58.       Top             =   2520
  59.       Width           =   2310
  60.    End
  61. Attribute VB_Name = "frmStretch2"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = False
  64. Attribute VB_PredeclaredId = True
  65. Attribute VB_Exposed = False
  66. Option Explicit
  67. Private FromXmin As Single
  68. Private FromYmin As Single
  69. Private ToXmin As Single
  70. Private ToYmin As Single
  71. Private XScale As Single
  72. Private YScale As Single
  73. ' Map the output pixel (ix_out, iy_out) to the input
  74. ' pixel (x_in, y_in).
  75. Private Sub MapPixel(ByVal ix_out As Single, ByVal iy_out As Single, ByRef x_in As Single, ByRef y_in As Single)
  76.     x_in = FromXmin + (ix_out - ToXmin) / XScale
  77.     y_in = FromYmin + (iy_out - ToYmin) / YScale
  78. End Sub
  79. ' Copy the picture.
  80. Private Sub StretchPicture(ByVal pic_from As PictureBox, ByVal pic_to As PictureBox, ByVal from_xmin As Single, ByVal from_ymin As Single, ByVal from_wid As Single, ByVal from_hgt As Single, ByVal to_xmin As Single, ByVal to_ymin As Single, ByVal to_wid As Single, ByVal to_hgt As Single)
  81.     ' Save mapping values.
  82.     FromXmin = from_xmin
  83.     FromYmin = from_ymin
  84.     ToXmin = to_xmin
  85.     ToYmin = to_ymin
  86.     XScale = to_wid / (from_wid - 1)
  87.     YScale = to_hgt / (from_hgt - 1)
  88.     ' Transform the image.
  89.     TransformImage pic_from, pic_to
  90. End Sub
  91. ' Transform the image.
  92. Private Sub TransformImage(ByVal pic_from As PictureBox, ByVal pic_to As PictureBox)
  93. Dim white_pixel As RGBTriplet
  94. Dim input_pixels() As RGBTriplet
  95. Dim result_pixels() As RGBTriplet
  96. Dim bits_per_pixel As Integer
  97. Dim ix_max As Single
  98. Dim iy_max As Single
  99. Dim x_in As Single
  100. Dim y_in As Single
  101. Dim ix_out As Integer
  102. Dim iy_out As Integer
  103. Dim ix_in As Integer
  104. Dim iy_in As Integer
  105. Dim dx As Single
  106. Dim dy As Single
  107. Dim dx1 As Single
  108. Dim dx2 As Single
  109. Dim dy1 As Single
  110. Dim dy2 As Single
  111. Dim v11 As Integer
  112. Dim v12 As Integer
  113. Dim v21 As Integer
  114. Dim v22 As Integer
  115.     ' Set the white pixel's value.
  116.     With white_pixel
  117.         .rgbRed = 255
  118.         .rgbGreen = 255
  119.         .rgbBlue = 255
  120.     End With
  121.     ' Get the pixels from pic_from.
  122.     GetBitmapPixels pic_from, input_pixels, bits_per_pixel
  123.     ' Get the pixels from pic_to.
  124.     GetBitmapPixels pic_to, result_pixels, bits_per_pixel
  125.     ' Get the original image's bounds.
  126.     ix_max = pic_from.ScaleWidth - 2
  127.     iy_max = pic_from.ScaleHeight - 2
  128.     ' Calculate the output pixel values.
  129.     For iy_out = 0 To pic_to.ScaleHeight - 1
  130.         For ix_out = 0 To pic_to.ScaleWidth - 1
  131.             ' Map the pixel value from
  132.             ' (ix_out, iy_out) to (x_in, y_in).
  133.             MapPixel ix_out, iy_out, x_in, y_in
  134.             ' Interpolate to find the pixel's value.
  135.             ' Find the nearest integral position.
  136.             ix_in = Int(x_in)
  137.             iy_in = Int(y_in)
  138.             ' See if this is out of bounds.
  139.             If (ix_in < 0) Or (ix_in > ix_max) Or _
  140.                (iy_in < 0) Or (iy_in > iy_max) _
  141.             Then
  142.                 ' The point is outside the image.
  143.                 ' Use white.
  144.                 result_pixels(ix_out, iy_out) = white_pixel
  145.             Else
  146.                 ' The point lies within the image.
  147.                 ' Calculate its value.
  148.                 dx1 = x_in - ix_in
  149.                 dy1 = y_in - iy_in
  150.                 dx2 = 1# - dx1
  151.                 dy2 = 1# - dy1
  152.                 With result_pixels(ix_out, iy_out)
  153.                     ' Calculate the red value.
  154.                     v11 = input_pixels(ix_in, iy_in).rgbRed
  155.                     v12 = input_pixels(ix_in, iy_in + 1).rgbRed
  156.                     v21 = input_pixels(ix_in + 1, iy_in).rgbRed
  157.                     v22 = input_pixels(ix_in + 1, iy_in + 1).rgbRed
  158.                     .rgbRed = _
  159.                         v11 * dx2 * dy2 + v12 * dx2 * dy1 + _
  160.                         v21 * dx1 * dy2 + v22 * dx1 * dy1
  161.                     ' Calculate the green value.
  162.                     v11 = input_pixels(ix_in, iy_in).rgbGreen
  163.                     v12 = input_pixels(ix_in, iy_in + 1).rgbGreen
  164.                     v21 = input_pixels(ix_in + 1, iy_in).rgbGreen
  165.                     v22 = input_pixels(ix_in + 1, iy_in + 1).rgbGreen
  166.                     .rgbGreen = _
  167.                         v11 * dx2 * dy2 + v12 * dx2 * dy1 + _
  168.                         v21 * dx1 * dy2 + v22 * dx1 * dy1
  169.                     ' Calculate the blue value.
  170.                     v11 = input_pixels(ix_in, iy_in).rgbBlue
  171.                     v12 = input_pixels(ix_in, iy_in + 1).rgbBlue
  172.                     v21 = input_pixels(ix_in + 1, iy_in).rgbBlue
  173.                     v22 = input_pixels(ix_in + 1, iy_in + 1).rgbBlue
  174.                     .rgbBlue = _
  175.                         v11 * dx2 * dy2 + v12 * dx2 * dy1 + _
  176.                         v21 * dx1 * dy2 + v22 * dx1 * dy1
  177.                 End With
  178.             End If
  179.         Next ix_out
  180.     Next iy_out
  181.     ' Set pic_to's pixels.
  182.     SetBitmapPixels pic_to, bits_per_pixel, result_pixels
  183.     pic_to.Picture = pic_to.Image
  184. End Sub
  185. ' Arrange the controls.
  186. Private Sub ArrangeControls(ByVal the_scale As Single)
  187. Dim new_wid As Single
  188. Dim new_hgt As Single
  189. Dim old_wid As Single
  190. Dim old_hgt As Single
  191.     ' Calculate the result's size.
  192.     new_wid = (picOriginal.ScaleWidth - 1) * the_scale
  193.     new_hgt = (picOriginal.ScaleHeight - 1) * the_scale
  194.     new_wid = ScaleX(new_wid, vbPixels, ScaleMode) + picOriginal.Width - ScaleX(picOriginal.ScaleWidth, vbPixels, ScaleMode)
  195.     new_hgt = ScaleY(new_hgt, vbPixels, ScaleMode) + picOriginal.Height - ScaleY(picOriginal.ScaleHeight, vbPixels, ScaleMode)
  196.     ' Position the result PictureBox.
  197.     picResult.Move _
  198.         picOriginal.Left + picOriginal.Width + 120, _
  199.         picOriginal.Top, new_wid, new_hgt
  200.     picResult.Line (0, 0)-(picResult.ScaleWidth, picResult.ScaleHeight), _
  201.         picResult.BackColor, BF
  202.     picResult.Picture = picResult.Image
  203.     picResult.Visible = True
  204.     ' This makes the image resize itself to
  205.     ' fit the picture.
  206.     picResult.Picture = picResult.Image
  207.     ' Make the form big enough.
  208.     new_wid = picResult.Left + picResult.Width
  209.     If new_wid < cmdEnlarge.Left + cmdEnlarge.Width _
  210.         Then new_wid = cmdEnlarge.Left + cmdEnlarge.Width
  211.     new_hgt = picResult.Top + picResult.Height
  212.     Move Left, Top, new_wid + 237, new_hgt + 816
  213.     DoEvents
  214. End Sub
  215. ' Start in the current directory.
  216. Private Sub Form_Load()
  217. Dim i As Integer
  218. Dim scale_factor As Single
  219. Dim X As Single
  220. Dim Y As Single
  221. Dim orig_wid As Single
  222. Dim orig_hgt As Single
  223. Dim wid As Single
  224. Dim hgt As Single
  225.     Show
  226.     Screen.MousePointer = vbHourglass
  227.     orig_wid = picOriginal.ScaleWidth
  228.     orig_hgt = picOriginal.ScaleHeight
  229.     scale_factor = 4
  230.     For i = 0 To 2
  231.         wid = orig_wid / scale_factor
  232.         hgt = orig_hgt / scale_factor
  233.         X = (orig_wid - wid) / 2
  234.         Y = (orig_hgt - hgt) / 2
  235.         DoEvents
  236.         StretchPicture picOriginal, _
  237.             picResult(i), _
  238.             X, Y, wid, hgt, _
  239.             0, 0, picResult(i).ScaleWidth, picResult(i).ScaleHeight
  240.         scale_factor = scale_factor * 2
  241.     Next i
  242.     Screen.MousePointer = vbDefault
  243. End Sub
  244.